home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jabout.tcl next >
Encoding:
Text File  |  1995-02-05  |  4.2 KB  |  139 lines
  1. # jabout.tcl - procedures for dealing with rich text
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non-profit, noncommercial use.
  6.  
  7. # j:about name richtext - create an about box containing richtext
  8. # j:about:button aboutbox label richtext - add a button to an about box
  9. # j:about_jay - return richtext describing me
  10. # j:about_tktcl - return richtext describing Tk and Tcl
  11.  
  12. # CHANGES:
  13. #   email address and url
  14.  
  15. ######################################################################
  16. # j:about name richtext - create an about box containing richtext
  17. ######################################################################
  18.  
  19. proc j:about { name args } {
  20.   j:parse_args {
  21.     {title "About"}
  22.   }
  23.   set w $name            ;# name of toplevel
  24.   set richtext [lindex $args 0]
  25.   
  26.   set old_focus [j:current_focus]    ;# so we can restore original focus
  27.   
  28.   if [winfo exists $w] {destroy $w}
  29.   toplevel $w
  30.   wm title $w $title
  31.   
  32.   text $w.t -width 65 -height 15 -borderwidth 20 -relief flat
  33.   j:rt text $w.t
  34.   eval $richtext
  35.   j:rt:done
  36.   
  37.   frame $w.b
  38.   button $w.b.ok -text OK -width 8 -command "
  39.     focus $old_focus
  40.     destroy $w
  41.   "
  42.   frame $w.b.ok-border -relief sunken -borderwidth 1
  43.   raise $w.b.ok
  44.   pack $w.b.ok -in $w.b.ok-border -padx 2 -pady 2
  45.  
  46.   pack [j:filler $w.b] -in $w.b -side left
  47.   pack [j:filler $w.b] -in $w.b -side right
  48.     
  49.   pack $w.b.ok-border -side right -pady 10
  50.   pack $w.t -in $w -side top -fill both
  51.   pack [j:rule $w -width 200] -in $w -side top -fill x
  52.   pack $w.b -in $w -side top -fill x
  53.   
  54.   j:dialogue $w            ;# position in centre of screen
  55.  
  56.   focus $w
  57.   bind $w <Key-Return> "$w.b.ok invoke"
  58. }
  59.  
  60. ######################################################################
  61. # j:about:button aboutbox label richtext - add a button to an about box
  62. ######################################################################
  63.  
  64. proc j:about:button { aboutbox label richtext } {
  65.   global j:about:button:count
  66.     if {[info exists j:about:button:count]} then {
  67.     set j:about:button:count [expr {${j:about:button:count} + 1}]
  68.   } else {
  69.     set j:about:button:count 0
  70.   }
  71.  
  72.   set parent $aboutbox.b    ;# name of frame with buttons
  73.   set button $parent.${j:about:button:count}
  74.   set border $button-border
  75.  
  76.   set min_width [expr {[string length $label] + 2}]
  77.   set width [expr {$min_width > 8 ? $min_width : 8}]
  78.   
  79.   button $button -text $label -width $width \
  80.     -command "j:rt text $aboutbox.t; $richtext; j:rt:done"
  81.   frame $border
  82.   raise $button
  83.   pack $button -in $border -padx 2 -pady 2
  84.   pack [j:filler $parent] $border -in $parent -side right
  85. }
  86.   
  87.   
  88.  
  89. ######################################################################
  90. # j:about_jay - talk about myself
  91. ######################################################################
  92.  
  93. proc j:about_jay {} {
  94.   return {
  95.     j:rt:hl "Jay Sekora"
  96.     j:rt:cr
  97.     j:rt:tt "js@bu.edu"
  98.     j:rt:cr
  99.     j:rt:rm "URL "
  100.     j:rt:tt "http://shore.net/~js/"
  101.     j:rt:par
  102.     j:rt:rm "I'm a Unix systems administrator at Boston University."
  103.     j:rt:par
  104.     j:rt:rm "I was a linguistics major in college.  "
  105.     j:rt:rm "I like spicy food, Celtic folk music, bad puns, New England "
  106.     j:rt:rm "contra dancing, and "
  107.     j:rt:it "Winnie the Pooh."
  108.   }
  109. }
  110.  
  111. ######################################################################
  112. # j:about_tktcl - describe tk and tcl
  113. ######################################################################
  114.  
  115. proc j:about_tktcl {} {
  116.   return {
  117.     j:rt:hl "Tk and Tcl"
  118.     j:rt:par
  119.     j:rt:rm "This application is written in "
  120.     j:rt:tt "wish"
  121.     j:rt:rm ", a scripting shell for X Windows applications based on the "
  122.     j:rt:rm "Tk toolkit, which in turn is based on the Tcl"
  123.     j:rt:rm " language and scripting library, all amazingly useful tools "
  124.     j:rt:rm "by John Ousterhout of Sun Microsystems."
  125.     j:rt:par
  126.     j:rt:rm "The Internet newsgroup "
  127.     j:rt:tt "comp.lang.tcl"
  128.     j:rt:rm " is devoted to Tcl and related tools, and a Tk/Tcl FAQ "
  129.     j:rt:rm "(`Frequently Asked Questions') is periodically posted.  "
  130.     j:rt:rm "The latest distributions are available on the FTP site "
  131.     j:rt:tt "ftp.cs.berkeley.edu"
  132.     j:rt:rm ", and "
  133.     j:rt:tt "ftp.aud.alcatel.com"
  134.     j:rt:rm " has the FAQ and user\255contributed scripts."
  135.   }
  136. }
  137.  
  138.  
  139.